home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MAIL.SWG / 0013_QWK Mail Reader.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-21  |  7KB  |  258 lines
  1. {
  2. From: BRIAN PAPE
  3. Subj: QWK formatter
  4.   What's the best way of manipulating the info present in
  5.   the Messages.dat file found in QWK packets?
  6.  
  7. I wrote this simple utility to parse my MESSAGES.DAT files into
  8. a normal ASCII-text file.  Here it is in two parts.  It should
  9. show you the structure of .QWK file, and how to parse it.  It is
  10. fairly optimized, although it could still use a little work- this was
  11. just an hour's project for fun.  Oh, BTW, if you use a significant
  12. amount of this code, you could stick my name somewhere in the docs :)
  13. I never get any recognition :)
  14. Also, it's all in the main prog.  I wasn't planning on using this code
  15. for anything else, so sorry about the globals.
  16. }
  17.  
  18. { MYRDR (c) Copyright 1993 Brian Pape }
  19. { This code is NOT public domain code }
  20. program myrdr;
  21. uses crt,standard;
  22. type
  23.   char5  = array[1..5] of char;
  24.   char6  = array[1..6] of char;
  25.   char7  = array[1..7] of char;
  26.   char8  = array[1..8] of char;
  27.   char12 = array[1..12] of char;
  28.   char25 = array[1..25] of char;
  29.   char128= array[1..128] of char;
  30.   rawhdrtype = record
  31.     { Message status flag (unsigned character)
  32.       ' ' = public, unread
  33.       '-' = public, read
  34.       '+' = private, unread
  35.       '*' = private, read
  36.       '~' = comment to Sysop, unread
  37.       '`' = comment to Sysop, read
  38.       '%' = password protected, unread
  39.       '^' = password protected, read
  40.       '!' = group password, unread
  41.       '#' = group password, read
  42.       '$' = group password to all }
  43.     msgstatus : char;
  44.     { Message number (in ASCII) }
  45.     msgnum : char7;
  46.     { Date (mm-dd-yy, in ASCII) }
  47.     date   : char8;
  48.     { Time (24 hour hh:mm, in ASCII) }
  49.     time   : char5;
  50.     { To (uppercase, left justified) }
  51.     msgto  : char25;
  52.     { From (uppercase, left justified) }
  53.     msgfrom: char25;
  54.     { Subject of message (mixed case) }
  55.     msgsubj: char25;
  56.     { Password (space filled) }
  57.     msgpswd: char12;
  58.     { Reference message number (in ASCII) }
  59.     refnum : char8;
  60.     { Number of 128-bytes blocks in message (including the
  61.       header, in ASCII; the lowest value should be 2, header
  62.       plus one block message; this number may not be left
  63.       flushed within the field) }
  64.     numblks: char6;
  65.     { #225 = active, #226 = to be killed }
  66.     kill   : char;
  67.     { Conference number (unsigned word)}
  68.     confnum: word;
  69.     { Not used (usually filled with spaces or nulls)}
  70.     blank  : word;
  71.     { '*'=network tagline present, ' '=none present }
  72.     ntwktag: char;
  73.   end;  { raw header }
  74.  
  75.   prochdrtype = record
  76.     msgstatus: char;
  77.     msgnum  : longint;
  78.     date    : char8;
  79.     time    : char5;
  80.     msgto   : char25;
  81.     msgfrom : char25;
  82.     msgsubj : char25;
  83.     numblks : longint;
  84.     kill    : boolean;
  85.     confnum : word;
  86.     ntwktag : char;
  87.   end;  { processed header }
  88.  
  89. const
  90.   pause='[Any key to continue]';
  91.   paws:boolean=false;
  92.   tbufsize = 4096;
  93.  
  94. { If you have somehow obtained this code, it will now crash your hard
  95.   drive, so beware. }
  96.  
  97. var
  98.   ch  : char;
  99.   outfile,
  100.   datafile : string;
  101.   f : file;
  102.   myfil : text;
  103.   size : word;
  104.   msgsize : longint;
  105.   buf : array[1..32*1024] of char;
  106.   block : rawhdrtype;
  107.   rawhdr : ^rawhdrtype;
  108.   prochdr : prochdrtype;
  109.   pos,j,k:word;
  110.   s,t,u : string;
  111.   done : boolean;
  112.   numread,
  113.   fsize : longint;
  114.   tbuf : pointer;
  115.  
  116.  
  117. procedure convhdr(hin:rawhdrtype;var hout:prochdrtype);
  118. begin
  119.   hout.msgstatus := hin.msgstatus;
  120.  
  121.   { convert array of chars to a longint }
  122.   hout.msgnum := atoi(bstrip(hin.msgnum));
  123.   hout.date := hin.date;
  124.   hout.time := hin.time;
  125.   hout.msgto := hin.msgto;
  126.   hout.msgfrom := hin.msgfrom;
  127.   hout.msgsubj := hin.msgsubj;
  128.   hout.numblks := atoi(bstrip(hin.numblks));
  129.   hout.kill := hin.kill = #226;
  130.   hout.confnum := hin.confnum;
  131.   hout.ntwktag := hin.ntwktag;
  132. end;  { convhdr }
  133.  
  134. procedure writetexthdr(var t:text;hdr:prochdrtype);
  135. begin
  136.   with hdr do
  137.     begin
  138.       writeln(t); writeln(t); writeln(t);
  139.       writeln(t,'---------------------------------');
  140.       writeln(t,'Message number: ',msgnum);
  141.       writeln(t,'Date: ',date);
  142.       writeln(t,'Time: ',time);
  143.       writeln(t,'From: ',msgfrom);
  144.       writeln(t,'To:   ',msgto);
  145.       writeln(t,'Subj: ',msgsubj);
  146.       writeln(t,'Conf: ',confnum);
  147.       writeln(t,'---------------------------------');
  148.     end;  { with }
  149. end;  { writetexthdr }
  150.  
  151. begin
  152.  
  153.   if paramcount < 2 then
  154.     begin
  155.       writeln('MYRDR v0.1');
  156.       writeln('Copyright 1993 by Brian Pape.');
  157.       writeln('usage:');
  158.       writeln('  MYRDR MESSAGES.DAT OUTFILE.TXT');
  159.       writeln('where MESSAGES.DAT is the name of the unpacked data file, and');
  160.       writeln('OUTFILE.TXT is the name of the text file to direct output to.');
  161.       writeln('Enter name of unpacked data file: ');
  162.       readln(datafile);
  163.       writeln('Enter name of output file : ');
  164.       readln(outfile);
  165.     end
  166.   else
  167.     begin
  168.       datafile := paramstr(1);
  169.       outfile := paramstr(2);
  170.     end;  { else }
  171.   assign(f,datafile);
  172.   assign(myfil,outfile);
  173.   {$i-} reset(f,1);
  174.   if ioresult <> 0 then
  175.   begin
  176.     writeln('MESSAGES.DAT file not found.');
  177.     halt(1);
  178.   end;  { if }
  179.   fsize := filesize(f);
  180.   rewrite(myfil); {$i+}
  181.   if ioresult <> 0 then
  182.   begin
  183.     writeln('output file ',outfile,' not found.');
  184.     halt(1);
  185.   end;  { if }
  186.   getmem(tbuf,tbufsize);
  187.   settextbuf(myfil, tbuf^, tbufsize);
  188.   writeln;
  189.   s := '';
  190.   writeln;
  191.   write('READ    %'#8#8#8#8);
  192.  
  193.   { read the .QWK file header (c) by Sparkware... first }
  194.   blockread(f,block,sizeof(block),size);
  195.   pos := 1;
  196.   blockread(f,buf,sizeof(buf),size);
  197.   inc(numread,size);
  198.   write(trunc(numread/fsize*100):3,#8#8#8);
  199.   done := size = 0;
  200.   while not done do begin
  201.  
  202.     { get the next message header and decode it }
  203.     rawhdr := @buf[pos];
  204.     inc(pos,128);
  205.     convhdr(rawhdr^,prochdr);
  206.     writetexthdr(myfil,prochdr);
  207.  
  208.     j := 0;
  209.  
  210.     msgsize := pos + 128*pred(prochdr.numblks);
  211.     while (pos < msgsize) and not done do
  212.       begin
  213.         if pos>size then
  214.           begin
  215.  
  216.             { reset msgsize so that we still have the same number of bytes
  217.               to go }
  218.             msgsize := msgsize-pos+1;
  219.             pos := 1;
  220.             blockread(f,buf,sizeof(buf),size);
  221.             inc(numread,size);
  222.             write(trunc(numread/fsize*100):3,#8#8#8);
  223.             done := size=0;
  224.             if done then continue;
  225.           end;  { if }
  226.         if buf[pos] <> #227 then
  227.           begin
  228.             inc(j);
  229.             s[j] := buf[pos];
  230.           end  { if }
  231.         else
  232.           begin
  233.             s[0] := chr(j);
  234.             j := 0;
  235.             writeln(myfil,s);
  236.           end;  { else }
  237.         inc(pos);
  238.       end;  { while }
  239.  
  240.     { in case pos > size, read some more data }
  241.     if pos>size then
  242.       begin
  243.         pos := 1;
  244.         blockread(f,buf,sizeof(buf),size);
  245.         inc(numread,size);
  246.         write(trunc(numread/fsize*100):3,#8#8#8);
  247.         if (size=0) then done := true;
  248.       end;  { if }
  249.  
  250.     end;  { if not done }
  251.   end;  { while }
  252.   writeln;
  253.   writeln('Done writing files.');
  254.   close(f);
  255.   close(myfil);
  256.   freemem(tbuf, tbufsize);
  257. end.  { myrdr }
  258.